home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / wb1a1.lha / wb / blkio.scm < prev    next >
Encoding:
Text File  |  1993-06-29  |  2.7 KB  |  79 lines
  1. ; Wb-tree File Based Associative String Data Base System.
  2. ; Copyright (c) 1991, 1992, 1993 Holland Mark Martin
  3. ;
  4. ;Permission to use, copy, modify, and distribute this software and its
  5. ;documentation for educational, research, and non-profit purposes and
  6. ;without fee is hereby granted, provided that the above copyright
  7. ;notice appear in all copies and that both that copyright notice and
  8. ;this permission notice appear in supporting documentation, and that
  9. ;the name of Holland Mark Martin not be used in advertising or
  10. ;publicity pertaining to distribution of the software without specific,
  11. ;written prior consent in each case.  Permission to incorporate this
  12. ;software into commercial products can be obtained from Jonathan
  13. ;Finger, Holland Mark Martin, 174 Middlesex Turnpike, Burlington, MA,
  14. ;01803-4467, USA.  Holland Mark Martin makes no representations about
  15. ;the suitability or correctness of this software for any purpose.  It
  16. ;is provided "as is" without express or implied warranty.  Holland Mark
  17. ;Martin is under no obligation to provide any services, by way of
  18. ;maintenance, update, or otherwise.
  19.  
  20. ;;; routines in this file return pass/fail (#t/#f)
  21.  
  22. (require (in-vicinity (program-vicinity) "sys"))
  23.  
  24. (define io-diag #f)
  25.  
  26. (define (init-filesystem!) #f)
  27.  
  28. (define (min-file-blk-size name) 128)
  29.  
  30. (define (blk-file-create name bsiz)
  31.   (open-output-file name))
  32.  
  33. (define (blk-file-open-modify name bsiz)
  34.   (open-io-file name))
  35.  
  36. (define (blk-file-open-read-only name bsiz)
  37.   (open-input-file name))
  38.  
  39. (define (blk-file-close file) (close-io-port file))
  40.  
  41. (define (blk-read file blk bsiz blknum)
  42.   (file-set-position file (* bsiz blknum))
  43.   (cond ((= bsiz (read-string file blk bsiz))
  44.      (if io-diag (fprintf diagout "rd:%*.c %10.ld\\n"
  45.                   (+ 1 (- (BLK-LEVEL blk) LEAF)) (BLK-TYP blk) blknum))
  46.      (if (BLK-TYP? blk FRL-TYP)
  47.          (set! read-fl-ct (+ read-fl-ct 1))
  48.          (set! read-ct (+ read-ct 1)))
  49.      #t)
  50.     (else
  51.      (fprintf diagout ">>>>ERROR<<<< couldn't read blk %ld\\n"
  52.           blknum)
  53.      #f)))
  54.  
  55. (define (blk-write file blk bsiz blknum)
  56.   (file-set-position file (* bsiz blknum))
  57.   (cond ((= bsiz (write-string file blk bsiz))
  58.      (if io-diag (fprintf diagout "wr:%*.c %10.ld\\n"
  59.                   (+ 1 (- (BLK-LEVEL blk) LEAF)) (BLK-TYP blk) blknum))
  60.      (if (BLK-TYP? blk FRL-TYP)
  61.          (set! write-fl-ct (+ write-fl-ct 1))
  62.          (set! write-ct (+ write-ct 1)))
  63.      #t)
  64.     (else
  65.      (fprintf diagout ">>>>ERROR<<<< couldn't write blk %ld\\n"
  66.           blknum)
  67.      #f)))
  68.  
  69. (define (extend-file file blk bsiz blknum)
  70.   (file-set-position file (* bsiz blknum))
  71.   (cond ((= bsiz (write-string file blk bsiz))
  72.      (if io-diag (fprintf diagout "Extending file %d blks\\n"
  73.                   (+ (quotient FLC-LEN 2) 1)))
  74.      #t)
  75.     (else
  76.      (fprintf diagout ">>>>ERROR<<<< couldn't extend file %ld\\n"
  77.           blknum)
  78.      #f)))
  79.